#' Register \code{\link{parallel}} with \code{Make} jobserver
#'
#' When run inside a script spawned by \code{Make}, returns the number
#' of available jobs that one of the R \code{\link{parallel}}
#' functions (such as \code{\link[parallel]{mclapply}}) can
#' spawn. When run outside of Make, simply returns the value of
#' \code{tokens}.
#'
#' @param tokens Maximum number of allowed jobs.
#'
#' @details When running Rscripts with parallelized Make, we run into
#'     the problem of Make spawning N number of jobs with each Rscript
#'     then spawning as many child processes as set by
#'     \code{mc.cores}. \code{register} hooks into Make's jobserver
#'     and synchronises the spawning of child processes in R with the
#'     spawning of jobs by Make.
#'
#'     To do this, we read and write from two file descriptors (rfd,
#'     wfd) passed by Make in the environmental flag
#'     \code{--jobserver-auth}. Make will write a token into rfd for
#'     each job slot available. \code{register} reads those tokens and
#'     returns the number of slots available for use with
#'     \code{\link{parallel}} and registers a hook function on
#'     script exit to write back the tokens to wfd so that the job
#'     slots are freed up again for Make's jobserver.
#'
#'     This means that if Make is called with \code{-j5} and two jobs
#'     have been spawned, in this case both being a hypothetical
#'     Rscript which will call \code{\link[parallel]{mclapply}}, then
#'     3 tokens will be available. \code{register} is greedy in that
#'     the first Rscript to read from rfd will grab all 3 tokens and
#'     can set mc.cores to 4 (1 job slot for the parent script + 3
#'     extra), while the second sets mc.cores to only 1.
#'
#'     If for some reason we want to ensure that R never spawns more
#'     than N number of child processes, regardless of how many tokens
#'     are available, we can set the parameter \code{tokens}.
#'
#' @section Warning: For Make to pass along \code{--jobserver-auth},
#'     the command in the target rule must be prefixed with '+'.
#'
#'     Furthermore, it's worth noting that \code{register} will never
#'     blocking on reading rfd. If there are no tokens available, then
#'     \code{register} will return 1 immediately. An area of future
#'     improvement would be to allow for the option of blocking until
#'     at least N tokens are available. However, you run into the
#'     obstacle of Make spawning the maximum number of jobs, each of
#'     which is waiting for say 1 extra token, thereby potentially
#'     blocking forever.
#'
#' @return \code{register} should always return at least 1 and at
#'     most, \code{tokens} + 1.
#'
#' @examples
#' options(mc.cores = register())
#'
#' @export
register <- function(tokens = pmax(parallel::detectCores() - 1, 1)) {
    if (.Platform$OS.type != "unix" | !dir.exists("/proc")) {
        warn("register only supports linux with /proc, returning 1 token")
        return(1)
    }

    # Either the script wasn't invoked with Make or Make is invoking
    # jobs serially. Either way we don't care about mismatch
    # parallelization.
    flags <- Sys.getenv("MAKEFLAGS")
    if (nchar(flags) == 0)
        return(tokens + 1)

    matches <- regexpr("(?<=--jobserver-auth=|--jobserver-fds=)(\\d,\\d)", flags, perl = T)
    if (length(matches) > 1 | matches == -1) {
        print("Unable to find jobserver FDs")
        return(1)
    }

    fds <- substr(flags, matches, matches + attr(matches, "match.length") - 1) %>%
        strsplit(",") %>%
        unlist

    proc <- file.path("/proc", Sys.getpid(), "fd")

    # Ugly hack to check if job is prefixed with `+` in Makefile,
    # otherwise file descriptors may still be readable/writable
    if (length(list.files(proc)) < 7)
        return(1)

    r <- file.path(proc, fds[1]) %>%
        file(open = "rb", blocking = F)

    # Any tokens we read is an additional child we can spawn. Don't
    # block; if there aren't any tokens available, then just return 1.
    tokens <- readChar(r, nchars = tokens)
    close(r)

    if (length(tokens) == 0 || nchar(tokens) == 0)
        return(1)

    # Regardless of errors in calling script, we need to return tokens
    # to Make.
    fn <- function(e) {
        w <- file.path(proc, fds[2]) %>%
            file(open = "wb", blocking = F)

        writeChar(tokens, w, eos = NULL)
    }
    reg.finalizer(.GlobalEnv, fn, onexit = T)

    # Add one since our calling R script is already allocated a token.
    return(nchar(tokens) + 1)
}

#' Check parallelized results for errors
#'
#' Given a list of outputs from \code{\link[parallel]{mclapply}} or
#' \code{\link[parallel]{mcMap}}, asserts whether any errors were
#' encountered.
#'
#' @param ll List of results
#'
#' @details Currently, no attempt is made to ascertain the location
#'     within the results list of any errors. Feel free to properly
#'     extend this function.
#'
#' @examples
#' \dontrun{
#' ll <- parallel::mclapply(1:3, sdf)
#' mc_assert(ll)
#' }
#'
#' @export
mc_assert <- function(ll) {
    if (!is.list(ll))
        ll <- as.list(ll)

    err <- Filter(is.try_error, ll) %>% unique

    if (length(err) > 0) {
        vapply(err, get_errmsg, character(1)) %>%
            paste(collapse = "\n") %>%
            stop(call. = F)
    }
}
